home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / l.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  5KB  |  210 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+}
  2. {$M 32768,0,655360}
  3.  
  4. program L;
  5. { Simple (unfinished) list-program, by Bas van Gaalen, Holland, PD
  6.   Needs a personal unit bcrt, tpfast is available... }
  7. uses
  8.   tpfast,bcrt,dos,crt;
  9.  
  10. type
  11.   LinePtr = ^LineRec;
  12.   LineRec = record
  13.               Line : string;
  14.               Next : LinePtr;
  15.             end;
  16.  
  17. var
  18.   TextFile  : text;
  19.   FirstLine,
  20.   CurLine,
  21.   LastLine  : LinePtr;
  22.   Search    : string[50];
  23.   NofLines  : word;
  24.   ScrHi     : byte;
  25.   Ascii,
  26.   Clear     : boolean;
  27.  
  28. {----------------------------------------------------------------------------}
  29.  
  30. procedure Initialize;
  31.  
  32. var
  33.   FileName : pathstr;
  34.  
  35. begin
  36.   if paramcount = 0 then begin
  37.     writeln('Enter filename on commandline');
  38.     halt;
  39.   end;
  40.   FileName := paramstr(1);
  41.  
  42.   assign(TextFile,FileName);
  43.   {$I-} reset(TextFile); {$I+}
  44.   if ioresult <> 0 then begin
  45.     writeln('File not found...');
  46.     halt;
  47.   end;
  48.  
  49.   NofLines := 0;
  50.   new(FirstLine);
  51.   FirstLine^.Next := nil;
  52.   CurLine := FirstLine;
  53.   repeat
  54.     readln(TextFile,CurLine^.Line);
  55.     new(CurLine^.Next);
  56.     CurLine := CurLine^.Next;
  57.     inc(NofLines);
  58.   until eof(TextFile);
  59.   CurLine^.Next := nil;
  60.   LastLine := CurLine^.Next;
  61.  
  62.   ScrHi := hi(windmax);
  63.   cursoroff;
  64.  
  65. end;
  66.  
  67. {----------------------------------------------------------------------------}
  68.  
  69. procedure List;
  70.  
  71. var
  72.   Key    : char;
  73.   Escape : boolean;
  74.   ScrPos : longint;
  75.   StPos  : integer;
  76.   I      : byte;
  77.  
  78. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  79.  
  80. procedure DumpScreen(LineNum : longint; Start : integer);
  81.  
  82. var
  83.   Tmp : string[80];
  84.   I   : word;
  85.   Len : byte;
  86.  
  87. begin
  88.   I := 0;
  89.   CurLine := FirstLine;
  90.   while (I <> LineNum) and (CurLine <> LastLine) do begin
  91.     CurLine := CurLine^.Next;
  92.     inc(I);
  93.   end;
  94.   I := 2;
  95.   while (I <= ScrHi) and (CurLine^.Next <> LastLine) do begin
  96.     fillchar(Tmp,sizeof(Tmp),#0);
  97.     if length(CurLine^.Line) < Start then Len := 0
  98.     else if integer(length(CurLine^.Line))-Start > 80 then Len := 80
  99.     else Len := length(CurLine^.Line)-Start;
  100.     move(CurLine^.Line[Start+1],Tmp[1],Len);
  101.     Tmp[0] := #80;
  102.     dspat(Tmp,1,I,lightgray);
  103.     CurLine := CurLine^.Next;
  104.     inc(I);
  105.   end;
  106.   if I < ScrHi then fillscreen(' ',1,I,80,ScrHi-I+1,lightgray);
  107. end;
  108.  
  109. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  110.  
  111. procedure Find(var LineNum : longint; var Start : integer; SearchStart : word);
  112.  
  113. var
  114.   Found  : boolean;
  115.   I      : word;
  116.  
  117. function StrUp(CnvStr : string) : string;
  118.  
  119. var
  120.   I : byte;
  121.  
  122. begin
  123.   for I := 1 to length(CnvStr) do CnvStr[I] := upcase(CnvStr[I]);
  124.   StrUp := CnvStr;
  125. end;
  126.  
  127. begin
  128.   if SearchStart = 0 then begin
  129.     fillscreen(' ',1,1,80,1,_lightgray);
  130.     gotoxy(2,1);
  131.     textattr := _lightgray;
  132.     write('Search: ');
  133.     cursoron; readln(Search); cursoroff;
  134.   end;
  135.   CurLine := FirstLine; I := 0;
  136.   while (I <> SearchStart) and (CurLine <> LastLine) do begin
  137.     CurLine := CurLine^.Next;
  138.     inc(I);
  139.   end;
  140.   Found := false;
  141.   while (not Found) and (CurLine <> LastLine) do begin
  142.     Found := pos(StrUp(Search),StrUp(CurLine^.Line)) <> 0;
  143.     if not Found then begin
  144.       CurLine := CurLine^.Next;
  145.       inc(I);
  146.     end;
  147.   end;
  148.   if Found then begin
  149.     LineNum := I;
  150.     Start := 0;
  151.   end
  152.   else begin
  153.     fillscreen(' ',1,1,80,1,_lightgray);
  154.     dspat('* Not Found *',2,1,_lightgray+white);
  155.     Clear := false;
  156.   end;
  157. end;
  158.  
  159. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  160.  
  161. begin
  162.   textattr := 0;
  163.   clrscr;
  164.   ScrPos := 0; StPos := 0;
  165.   Escape := false;
  166.   Clear := true;
  167.   repeat
  168.     DumpScreen(ScrPos,StPos);
  169.     if Clear then begin
  170.       fillscreen(' ',1,1,80,1,_lightgray);
  171.       textattr := _lightgray;
  172.       if Ascii then dspat('ASCII',60,1,_lightgray)
  173.       else dspat('HEX  ',60,1,_lightgray);
  174.       gotoxy(67,1); write(ScrPos+1:3,'/',NofLines+1:3);
  175.       gotoxy(75,1); write(StPos:3);
  176.     end;
  177.     Clear := true;
  178.     Key := readkey;
  179.     if Key = #0 then begin
  180.       Key := readkey;
  181.       case ord(Key) of
  182.          72 : if ScrPos > 0 then dec(ScrPos); { Up }
  183.          80 : if ScrPos < NofLines then inc(ScrPos); { Down }
  184.          73 : if ScrPos-ScrHi >= 0 then dec(ScrPos,ScrHi)
  185.               else ScrPos := 0; { PageUp }
  186.          81 : if ScrPos <= NofLines-ScrHi+1 then inc(ScrPos,ScrHi); { PageDn }
  187.          71 : ScrPos := 0; { Home }
  188.          79 : ScrPos := NofLines-ScrHi+1; { End }
  189.          77 : if StPos+10 <= 210 then inc(StPos,10); { Right }
  190.          75 : if StPos-10 >= 0 then dec(StPos,10); { Left }
  191.         117 : StPos := 210; { CtrlEnd }
  192.         119 : StPos := 0; { CtrlHome }
  193.       end;
  194.     end
  195.     else case upcase(Key) of
  196.       #27 : Escape := true; { Escape }
  197.       'F' : Find(ScrPos,StPos,0); { Find }
  198.       'N' : Find(ScrPos,StPos,ScrPos+1); { Find Next }
  199.     end;
  200.   until Escape;
  201.   textattr := lightgray; clrscr; cursoron;
  202. end;
  203.  
  204. {----------------------------------------------------------------------------}
  205.  
  206. begin
  207.   Initialize;
  208.   List;
  209. end.
  210.